home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / vbpong1a / cdxvbscr.cls < prev    next >
Encoding:
Visual Basic class definition  |  1999-08-08  |  7.0 KB  |  254 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "CDXVBScreen"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. ' ALMOST working...
  15.  
  16. Private Declare Function ShowCursor Lib "User32" (ByVal bShow As Long) As Long
  17.  
  18. Private Declare Function VarPtrArray Lib "msvbvm50.dll" Alias "VarPtr" (Ptr() As Any) As Long
  19. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
  20. Private Declare Function ClientToScreen Lib "User32" (ByVal hWnd As Long, lpPoint As Any) As Long
  21. Private Declare Function GetClientRect Lib "User32" (ByVal hWnd As Long, lpRect As RECT) As Long
  22.  
  23. Private Type SAFEARRAYBOUND
  24.     cElements As Long
  25.     lLbound As Long
  26. End Type
  27.  
  28. Private Type SAFEARRAY1D
  29.     cDims As Integer
  30.     fFeatures As Integer
  31.     cbElements As Long
  32.     cLocks As Long
  33.     pvData As Long
  34.     Bounds(0 To 0) As SAFEARRAYBOUND
  35. End Type
  36.  
  37. Private Type SAFEARRAY2D
  38.     cDims As Integer
  39.     fFeatures As Integer
  40.     cbElements As Long
  41.     cLocks As Long
  42.     pvData As Long
  43.     Bounds(0 To 1) As SAFEARRAYBOUND
  44. End Type
  45.  
  46. Private video_buffer() As Byte
  47. Private sa As SAFEARRAY2D
  48.  
  49. Public m_lpdd As IDirectDraw2
  50. Private m_ddsd As DDSURFACEDESC
  51. Public m_lpDDSFront As IDirectDrawSurface2
  52. Public m_lpDDSBack As IDirectDrawSurface2
  53. Public m_Clipper As IDirectDrawClipper
  54.  
  55. Public m_PixelWidth As Integer
  56. Public m_PixelHeight As Integer
  57. Public m_BPP As Integer
  58. Public m_HWND As Long
  59. Public m_HDC As Long
  60. Public m_Font As Long
  61. Private m_FullScreen As Boolean
  62.  
  63. Private ScreenRect As RECT
  64.  
  65. Public Function CreateFullScreen(hWnd As Long, Width As Integer, Height As Integer, BPP As Integer, bVGA As Boolean) As Boolean
  66.       Dim result As Long
  67.       Dim dwflags As Long
  68.       Dim ddscaps1 As DDSCAPS
  69.       Dim ddsd As DDSURFACEDESC
  70.       
  71.       m_PixelWidth = Width
  72.       m_PixelHeight = Height
  73.       m_HWND = hWnd
  74.       m_BPP = BPP
  75.  
  76.       dwflags = DDSCL_EXCLUSIVE Or DDSCL_FULLSCREEN Or DDSCL_ALLOWREBOOT Or DDSCL_ALLOWMODEX
  77.  
  78.       DirectDrawCreate ByVal 0&, m_lpdd, Nothing
  79.       
  80.       m_lpdd.SetCooperativeLevel hWnd, dwflags
  81.       
  82.       If bVGA = True Then
  83.             m_lpdd.SetDisplayMode Width, Height, BPP, 0, DDSDM_STANDARDVGAMODE
  84.       Else
  85.             m_lpdd.SetDisplayMode Width, Height, BPP, 0, 0
  86.       End If
  87.  
  88.       ddsd.dwSize = Len(ddsd)
  89.       ddsd.dwflags = DDSD_CAPS Or DDSD_BACKBUFFERCOUNT
  90.       ddsd.DDSCAPS.dwCaps = DDSCAPS_PRIMARYSURFACE Or DDSCAPS_FLIP Or DDSCAPS_COMPLEX
  91.       ddsd.dwBackBufferCount = 1
  92.  
  93.       m_lpdd.CreateSurface ddsd, m_lpDDSFront, Nothing
  94.       
  95.       ddscaps1.dwCaps = DDSCAPS_BACKBUFFER
  96.       
  97.       m_lpDDSFront.GetAttachedSurface ddscaps1, m_lpDDSBack
  98.       
  99.       With ScreenRect
  100.             .top = 0
  101.             .left = 0
  102.             .bottom = Height
  103.             .right = Width
  104.       End With
  105.       
  106.       m_FullScreen = True
  107. End Function
  108.  
  109. Public Sub CreateWindowed(hWnd As Long, Width As Integer, Height As Integer)
  110.       Dim dwflags As Long
  111.       Dim ddscaps1 As DDSCAPS
  112.       Dim ddsd As DDSURFACEDESC
  113.       
  114.       m_PixelWidth = Width
  115.       m_PixelHeight = Height
  116.       m_HWND = hWnd
  117.       m_BPP = GetBPP()
  118.       
  119.       dwflags = DDSCL_NORMAL
  120.       
  121.       DirectDrawCreate ByVal 0&, m_lpdd, Nothing
  122.       
  123.       m_lpdd.SetCooperativeLevel hWnd, dwflags
  124.       
  125.       ddsd.dwSize = Len(ddsd)
  126.       ddsd.dwflags = DDSD_CAPS
  127.       ddsd.DDSCAPS.dwCaps = DDSCAPS_PRIMARYSURFACE
  128.       
  129.       m_lpdd.CreateSurface ddsd, m_lpDDSFront, Nothing
  130.       
  131.       ddsd.dwflags = DDSD_CAPS Or DDSD_WIDTH Or DDSD_HEIGHT
  132.       ddsd.DDSCAPS.dwCaps = DDSCAPS_OFFSCREENPLAIN
  133.       ddsd.dwWidth = Width
  134.       ddsd.dwHeight = Height
  135.       
  136.       m_lpdd.CreateSurface ddsd, m_lpDDSBack, Nothing
  137.       
  138.       m_lpdd.CreateClipper 0, m_Clipper, Nothing
  139.       
  140.       m_Clipper.SetHWnd 0, hWnd
  141.       
  142.       m_lpDDSFront.SetClipper m_Clipper
  143.       
  144.       m_FullScreen = False
  145.       With ScreenRect
  146.             .top = 0
  147.             .left = 0
  148.             .bottom = Height
  149.             .right = Width
  150.       End With
  151. End Sub
  152.  
  153. Public Function Flip() As Long
  154.       If m_FullScreen Then
  155.             m_lpDDSFront.Flip Nothing, DDFLIP_WAIT
  156.       Else
  157.             Dim fx As DDBLTFX
  158.             fx.dwSize = Len(fx)
  159.             fx.dwRop = SRCCOPY
  160.             Dim ClientRect As RECT
  161.             
  162.             GetClientRect m_HWND, ClientRect
  163.             ClientToScreen m_HWND, ClientRect.left
  164.             ClientToScreen m_HWND, ClientRect.right
  165.             m_lpDDSFront.Blt ClientRect, m_lpDDSBack, ByVal 0&, DDBLT_ROP Or DDBLT_WAIT, fx
  166.       End If
  167. End Function
  168.  
  169. Public Sub CloseCDXVBScreen()
  170.       If m_FullScreen Then
  171.             m_lpdd.FlipToGDISurface
  172.             m_lpdd.SetCooperativeLevel 0, DDSCL_NORMAL
  173.             m_lpdd.RestoreDisplayMode
  174.  
  175.             Set m_lpDDSBack = Nothing
  176.             Set m_lpDDSFront = Nothing
  177.             Set m_lpdd = Nothing
  178.       Else
  179.             m_lpdd.SetCooperativeLevel 0, DDSCL_NORMAL
  180.             
  181.             Set m_Clipper = Nothing
  182.             Set m_lpDDSBack = Nothing
  183.             Set m_lpDDSFront = Nothing
  184.             Set m_lpdd = Nothing
  185.       End If
  186. End Sub
  187.  
  188. Public Sub ClearBack()
  189.       Dim ClearFX As DDBLTFX
  190.  
  191.       With ClearFX
  192.             .dwSize = Len(ClearFX)
  193.             .dwFillColor = 0
  194.       End With
  195.  
  196.       m_lpDDSBack.Blt ScreenRect, Nothing, ScreenRect, DDBLT_COLORFILL Or DDBLT_WAIT, ClearFX
  197. End Sub
  198.  
  199. Public Sub HideMouse()
  200.       ShowCursor False
  201. End Sub
  202.  
  203. Public Sub ShowMouse()
  204.       ShowCursor True
  205. End Sub
  206.  
  207. Public Sub SurfGetBackDC()
  208.       m_lpDDSBack.GetDC m_HDC
  209. End Sub
  210.  
  211. Public Sub SurfReleaseBackDC()
  212.       m_lpDDSBack.ReleaseDC m_HDC
  213. End Sub
  214.  
  215. Private Sub Class_Terminate()
  216.       Call CloseCDXVBScreen
  217. End Sub
  218.  
  219. Public Sub LockMe()
  220.       CopyMemory m_ddsd, ByVal 0&, Len(m_ddsd)
  221.       m_ddsd.dwSize = Len(m_ddsd)
  222.  
  223.       m_lpDDSBack.Lock ByVal 0&, m_ddsd, DDLOCK_WAIT Or DDLOCK_SURFACEMEMORYPTR, 0
  224.  
  225.       With sa
  226.             .cbElements = 1
  227.             .cDims = 2
  228.             .Bounds(0).lLbound = 0
  229.             .Bounds(0).cElements = m_PixelHeight - 1
  230.             .Bounds(1).lLbound = 0
  231.             .Bounds(1).cElements = m_PixelWidth - 1
  232.             .pvData = m_ddsd.lpSurface
  233.       End With
  234.       CopyMemory ByVal VarPtrArray(video_buffer), VarPtr(sa), 4
  235. End Sub
  236.  
  237. Public Sub Pixel(x As Integer, y As Integer, Color As Integer)
  238.       video_buffer(x, y) = Color
  239. End Sub
  240.  
  241. Public Sub UnLockMe()
  242.       m_lpDDSBack.Unlock m_ddsd.lpSurface
  243.  
  244.       CopyMemory ByVal VarPtrArray(video_buffer), ByVal 0&, 4
  245. End Sub
  246.  
  247. Public Function GetBPP() As Integer
  248.       Dim hDC As Long
  249.       
  250.       hDC = GetDC(hDC)
  251.       GetBPP = GetDeviceCaps(hDC, PLANES) * GetDeviceCaps(hDC, BITSPIXEL)
  252.       ReleaseDC ByVal 0&, hDC
  253. End Function
  254.